%{

#include <string.h>
#include <stdio.h>
#include "config.h"
#include "macros.h"
#include "debug.h"
#include "opcodes.h"
#include "scratchpad.h"
#include "ident.h"
#include "compiler.h"
#include "trees.h"
#include "simulate.h"
#include "stralloc.h"

/*
 * This is the grammar definition of LPC, and its parse tree generator.
 */

/* The current context. */
static int context;

/* The current declared type for variables. */
static int current_type;

%}

/*
 * Token definitions.
 *
 * Appearing in the precedence declarations are:
 *      '+'  '-'  '/'  '*'  '%'
 *      '<'  '>'
 *
 * Other single character tokens recognized in this grammar:
 *      '{'  '}'  ','  ';'
 *      '('  ')'  '['  ']' ':'
 */
%token L_STRING L_NUMBER L_REAL
%token L_BASIC_TYPE
%token L_DEFINED_NAME L_IDENTIFIER

%token L_ASSIGN
%token L_LAND L_LOR
%token L_ORDER
%token L_NOT

%token L_IF L_ELSE
%token L_WHILE L_DO L_FOR L_FOREACH L_IN
%token L_BREAK L_CONTINUE
%token L_RETURN
%token L_ARROW
%token L_ARRAY_OPEN L_MAPPING_OPEN

/*
 * 'Dangling else' shift/reduce conflict is well known...
 *  define these precedences to shut yacc up.
 */

%nonassoc LOWER_THAN_ELSE
%nonassoc L_ELSE

/*
 * Operator precedence and associativity...
 * greatly simplify the grammar.
 */

%right L_ASSIGN
%left L_LOR
%left L_LAND
%left L_EQ L_NE
%left L_ORDER
%left '+' '-'
%left '*' '%' '/'
%right L_NOT

/*
 * YYTYPE
 *
 * Anything with size > 4 is commented.  Sizes assume typical 32 bit
 * architecture.  This size of the largest element of this union should
 * be kept as small as possible to optimize copying of compiler stack
 * elements.
 */
%union
{
	int number;
	float real;
	char *string;
	int type;
	short num_arg;
	ident_hash_elem_t *ihe;
	parse_node_t *node;
	struct {
		parse_node_t *node;
		char num;
	} decl; /* 5 */
}

/*
 * Type declarations.
 */

/* These hold opcodes */
%type <number> L_ASSIGN L_ORDER

/* Holds a variable index */
%type <number> single_new_local_def

/* These hold arbitrary numbers */
%type <number> L_NUMBER

/* These hold a real number */
%type <real>   L_REAL

/* holds a string constant */
%type <string> L_STRING

/* Holds the number of elements in a list and whether it must be a prototype */
%type <num_arg> argument_list argument

/* These hold a list of possible interpretations of an identifier */
%type <ihe> L_DEFINED_NAME

/* These hold a type */
%type <type> optional_star
%type <type> L_BASIC_TYPE
%type <type> cast

/* holds an identifier or some sort */
%type <string> L_IDENTIFIER identifier
%type <string> new_local_name

/* The following return a parse node */
%type <node> number real string expr0 comma_expr for_expr
%type <node> expr_list expr_list2 expr_list3
%type <node> expr_list4 assoc_pair expr4 lvalue function_call
%type <node> new_local_def statement while cond do
%type <node> return optional_else_part block_or_semi
%type <node> statements
%type <node> expr_list_node
%type <node> single_new_local_def_with_init
%type <node> all def
%type <node> program

/* The following hold information about blocks and local vars */
%type <decl> local_declarations local_name_list block decl_block
%type <decl> foreach_var foreach_vars first_for_expr foreach for

/* This holds a flag */
%type <number> new_arg

%%

all:
		program
{
	debug(grammar, ("all : program"));
	comp_trees[TREE_MAIN] = $$;
}
	;

program:
		program def possible_semi_colon
{
	debug(grammar, ("program : program def possible_semi_colon"));
	CREATE_TWO_VALUES($$, 0, $1, $2);
}
	|	/* empty */
{
	debug(grammar, ("program : "));
	$$ = 0;
}
	;

def:
		L_BASIC_TYPE optional_star identifier
{
	debug(grammar, ("def : L_BASIC_TYPE optional_star identifier ..."));
	exact_types = ($1 & 0xffff) | $2;
	if ((($1 & 0xffff) == TYPE_VOID) && $2) {
		yyerror("Illegal to declare type void *.");
	}
}
		'(' argument ')'
{
	debug(grammar, ("def : ... ( argument ) ..."));
	char *p = $3;
	$3 = make_shared_string($3);
	scratch_free(p);

	/*
	 * Define a prototype. If it is a real function, then the
	 * prototype will be replaced below.
	 */

	$<number>$ = FUNC_PROTOTYPE;
	$<number>$ |= ($1 >> 16);

	define_new_function($3, $6, 0, $<number>$, ($1 & 0xffff)| $2);
	/* This is safe since it is guaranteed to be in the
	   function table, so it can't be dangling */
	free_string($3);
	context = 0;
}
		block_or_semi
{
	debug(grammar, ("def : ... block_or_semi"));
	/* Either a prototype or a block */
	if ($9) {
		int fun;

		$<number>8 &= ~FUNC_PROTOTYPE;
		if ($9->kind != NODE_RETURN &&
				($9->kind != NODE_TWO_VALUES
				 || $9->r.expr->kind != NODE_RETURN)) {
			parse_node_t *replacement;
			CREATE_STATEMENTS(replacement, $9, 0);
			CREATE_RETURN(replacement->r.expr, 0);
			$9 = replacement;
		}

		fun = define_new_function($3, $6,
				max_num_locals - $6,
				$<number>8, ($1 & 0xffff) | $2);
		if (fun != -1) {
			$$ = new_node_no_line();
			$$->kind = NODE_FUNCTION;
			$$->v.number = fun;
			$$->l.number = max_num_locals;
			$$->r.expr = $9;
		} else
			$$ = 0;
	} else
		$$ = 0;
	free_all_local_names(!!$9);
}
	|	L_BASIC_TYPE name_list ';'
{
	debug(grammar, ("def : L_BASIC_TYPE name_list ;"));
	$$ = 0;
}
	;

name_list:
		new_name
{
	debug(grammar, ("name_list : new_name"));
}
	|	new_name ',' name_list
{
	debug(grammar, ("name_list : new_name , name_list"));
}
	;

new_name:
		optional_star identifier
{
	debug(grammar, ("new_name : optional_star identifier"));

	if (current_type == TYPE_VOID)
		yyerror("Illegal to declare global variable of type void.");

	define_new_variable($2, current_type | $1);
	scratch_free($2);
}
	|	optional_star identifier L_ASSIGN expr0
{
	debug(grammar, ("new_name : optional_star identifier L_ASSIGN expr0"));
	parse_node_t *expr, *newnode;
	int type;

	if (current_type == TYPE_VOID)
		yyerror("Illegal to declare global variable of type void.");

	if ($3 != F_ASSIGN)
		yyerror("Only '=' is legal in initializers.");

	/* ignore current_type == 0, which gets a missing type error
	   later anyway */
	if (current_type) {
		type = current_type | $1;
		if (!compatible_types(type, $4->type)) {
			char buff[256];
			char *end = EndOf(buff);
			char *p;

			p = strput(buff, end, "Type mismatch ");
			p = get_two_types(p, end, type, $4->type);
			p = strput(p, end, " when initializing ");
			p = strput(p, end, $2);
			yyerror(buff);
		}
	}
	$4 = do_promotions($4, type);

	CREATE_BINARY_OP(expr, F_VOID_ASSIGN, 0, $4, 0);
	CREATE_OPCODE_1(expr->r.expr, F_GLOBAL_LVALUE, 0,
			define_new_variable($2, current_type | $1));
	newnode = comp_trees[TREE_INIT];
	CREATE_TWO_VALUES(comp_trees[TREE_INIT], 0,
			newnode, expr);
	scratch_free($2);
}
	;

optional_star:
		/* empty */
{
	debug(grammar, ("optional_star : "));
	$$ = 0;
}
	|	'*'
{
	debug(grammar, ("optional_star : *"));
	$$ = TYPE_MOD_ARRAY;
}
	;

identifier:
		L_DEFINED_NAME
{
	debug(grammar, ("identifier : L_DEFINED_NAME"));
	$$ = scratch_copy($1->name);
}
	|	L_IDENTIFIER
{
	debug(grammar, ("identifier : L_IDENTIFIER"));
}
	;

argument:
		/* empty */
{
	debug(grammar, ("argment : "));
	$$ = 0;
}
	|	argument_list
{
	debug(grammar, ("argment : argument_list"));
}
	;

argument_list:
		new_arg
{
	debug(grammar, ("argument_list : new_arg"));
	if ($1 == TYPE_VOID) {
		$$ = 0;
	} else {
		$$ = 1;
	}
}
	|	argument_list ',' new_arg
{
	debug(grammar, ("argument_list : argument_list , new_arg"));
	if (!$$)    /* first arg was void w/no name */
		yyerror("argument of type void must be the only argument.");
	if ($3 == TYPE_VOID)
		yyerror("Illegal to declare argument of type void.");

	$$ = $1 + 1;
}
	;

new_arg:
		L_BASIC_TYPE optional_star
{
	debug(grammar, ("new_arg : L_BASIC_TYPE optional_star"));
	$$ = $1 | $2;
	if ($1 == TYPE_VOID && $2) {
		yyerror("Illegal to declare type void *.");
	} else if ($1 != TYPE_VOID) {
		/* TODO: is "" a magic string?
		 * CLUE: IdentHash() return 0 for it...
		 */
		add_local_name("", $1 | $2);
	}
}
	|	L_BASIC_TYPE optional_star new_local_name
{
	debug(grammar, ("new_arg : L_BASIC_TYPE optional_star new_local_name"));
	$$ = $1 | $2;
	if ($1 == TYPE_VOID) {
		yyerror("Illegal to declare argument of type void.");
	}
	add_local_name($3, $$);
	scratch_free($3);
}
	;

new_local_name:
		L_IDENTIFIER
{
	debug(grammar, ("new_local_name : L_IDENTIFIER"));
}
	|	L_DEFINED_NAME
{
	debug(grammar, ("new_local_name : L_DEFINED_NAME"));
	if ($1->dn.local_num != -1) {
		char buff[256];
		char *end = EndOf(buff);
		char *p;

		p = strput(buff, end, "Illegal to redeclare local name '");
		p = strput(p, end, $1->name);
		p = strput(p, end, "'");
		yyerror(buff);
	}
	$$ = scratch_copy($1->name);
}
	;

block_or_semi:
		block
{
	debug(grammar, ("block_or_semi : block"));
	$$ = $1.node;
	if (!$$) {
		CREATE_RETURN($$, 0);
	}
}
	|	';'
{
	debug(grammar, ("block_or_semi : ;"));
	$$ = 0;
}
	|	error
{
	debug(grammar, ("block_or_semi : error"));
	$$ = 0;
}
	;

block:
		'{' local_declarations statements '}'
{
	debug(grammar, ("block : { local_declarations statements }"));
	if ($2.node && $3) {
		CREATE_STATEMENTS($$.node, $2.node, $3);
	} else {
		$$.node = ($2.node ? $2.node : $3);
	}
	$$.num = $2.num;
}
	;

local_declarations:
		/* empty */
{
	debug(grammar, ("local_declarations : "));
	$$.node = 0;
	$$.num = 0;
}
	|	local_declarations L_BASIC_TYPE
{
	debug(grammar, ("local_declarations : local_declarations L_BASIC_TYPE ..."));
	if ($2 == TYPE_VOID)
		yyerror("Illegal to declare local variable of type void.");
	/* can't do this in L_BASIC_TYPE b/c local_name_list contains
	 * expr0 which contains cast which contains basic_type
	 */
	current_type = $2;
}
		local_name_list ';'
{
	debug(grammar, ("local_declarations : ... local_name_list ;"));
	if ($1.node && $4.node) {
		CREATE_STATEMENTS($$.node, $1.node, $4.node);
	} else {
		$$.node = ($1.node ? $1.node : $4.node);
	}
	$$.num = $1.num + $4.num;
}
	;

local_name_list:
		new_local_def
{
	debug(grammar, ("local_name_list : new_local_def"));
	$$.node = $1;
	$$.num = 1;
}
	|	new_local_def ',' local_name_list
{
	debug(grammar, ("local_name_list : new_local_def , local_name_list"));
	if ($1 && $3.node) {
		CREATE_STATEMENTS($$.node, $1, $3.node);
	} else {
		$$.node = ($1 ? $1 : $3.node);
	}
	$$.num = 1 + $3.num;
}
	;

new_local_def:
		optional_star new_local_name
{
	debug(grammar, ("new_local_def : optional_star new_local_name"));
	add_local_name($2, current_type | $1 | LOCAL_MOD_UNUSED);

	scratch_free($2);
	$$ = 0;
}
	|	optional_star new_local_name L_ASSIGN expr0
{
	debug(grammar, ("new_local_def : optional_star new_local_name L_ASSIGN expr0"));
	int type = current_type | $1;

	if ($3 != F_ASSIGN)
		yyerror("Only '=' is allowed in initializers.");
	if (!compatible_types($4->type, type)) {
		char buff[256];
		char *end = EndOf(buff);
		char *p;

		p = strput(buff, end, "Type mismatch ");
		p = get_two_types(p, end, type, $4->type);
		p = strput(p, end, " when initializing ");
		p = strput(p, end, $2);

		yyerror(buff);
	}

	$4 = do_promotions($4, type);

	CREATE_UNARY_OP_1($$, F_VOID_ASSIGN_LOCAL, 0, $4,
			add_local_name($2, current_type | $1 | LOCAL_MOD_UNUSED));
	scratch_free($2);
}
	;

expr0:
		lvalue L_ASSIGN expr0
{
	debug(grammar, ("expr0 : lvalue L_ASSIGN expr0"));
	parse_node_t *l = $1, *r = $3;
	/* set this up here so we can change it below */
	/* assignments are backwards; rhs is evaluated before
	   lhs, so put the RIGHT hand side on the LEFT hand
	   side of the tree node. */
	CREATE_BINARY_OP($$, $2, r->type, r, l);

	if (!compatible_types(r->type, l->type)) {
		char buf[256];
		char *end = EndOf(buf);
		char *p;

		p = strput(buf, end, "Bad assignment ");
		p = get_two_types(p, end, l->type, r->type);
		p = strput(p, end, ".");
		yyerror(buf);
	}

	if ($2 == F_ASSIGN)
		$$->l.expr = do_promotions(r, l->type);
}
	|	error L_ASSIGN expr0
{
	debug(grammar, ("expr0 : error L_ASSIGN expr0"));
	yyerror("Illegal LHS");
	CREATE_ERROR($$);
}
	|	expr0 L_LOR expr0
{
	debug(grammar, ("expr0 : expr0 L_LOR expr0"));
	CREATE_LAND_LOR($$, F_LOR, $1, $3);
	if (IS_NODE($1, NODE_LAND_LOR, F_LOR))
		$1->kind = NODE_BRANCH_LINK;
}
	|	expr0 L_LAND expr0
{
	debug(grammar, ("expr0 : expr0 L_LAND expr0"));
	CREATE_LAND_LOR($$, F_LAND, $1, $3);
	if (IS_NODE($1, NODE_LAND_LOR, F_LAND))
		$1->kind = NODE_BRANCH_LINK;
}
	|	expr0 L_EQ expr0
{
	debug(grammar, ("expr0 : expr0 L_EQ expr0"));
	if (!compatible_types2($1->type, $3->type)){
		char buf[256];
		char *end = EndOf(buf);
		char *p;

		p = strput(buf, end, "== always false because of incompatible types ");
		p = get_two_types(p, end, $1->type, $3->type);
		p = strput(p, end, ".");
		yyerror(buf);
	}
	/* x == 0 -> !x */
	if (IS_NODE($1, NODE_NUMBER, 0)) {
		CREATE_UNARY_OP($$, F_NOT, TYPE_NUMBER, $3);
	} else
		if (IS_NODE($3, NODE_NUMBER, 0)) {
			CREATE_UNARY_OP($$, F_NOT, TYPE_NUMBER, $1);
		} else {
			CREATE_BINARY_OP($$, F_EQ, TYPE_NUMBER, $1, $3);
		}
}
	|	expr0 L_NE expr0
{
	debug(grammar, ("expr0 : expr0 L_NE expr0"));
	if (!compatible_types2($1->type, $3->type)){
		char buf[256];
		char *end = EndOf(buf);
		char *p;

		p = strput(buf, end, "!= always true because of incompatible types ");
		p = get_two_types(p, end, $1->type, $3->type);
		p = strput(p, end, ".");
		yyerror(buf);
	}
	CREATE_BINARY_OP($$, F_NE, TYPE_NUMBER, $1, $3);
}
	|	expr0 L_ORDER expr0
{
	debug(grammar, ("expr0 : expr0 L_ORDER expr0"));
	int t1 = $1->type;
	int t3 = $3->type;

	if (!COMP_TYPE(t1, TYPE_NUMBER)
			&& !COMP_TYPE(t1, TYPE_STRING)) {
		char buf[256];
		char *end = EndOf(buf);
		char *p;

		p = strput(buf, end, "Bad left argument to '");
		/* TODO: query_instr_name
		p = strput(p, end, query_instr_name($2));
		*/
		p = strput(p, end, "' : \"");
		p = get_type_name(p, end, t1);
		p = strput(p, end, "\"");
		yyerror(buf);
	} else if (!COMP_TYPE(t3, TYPE_NUMBER)
			&& !COMP_TYPE(t3, TYPE_STRING)) {
		char buf[256];
		char *end = EndOf(buf);
		char *p;

		p = strput(buf, end, "Bad right argument to '");
		/* TODO: query_instr_name
		p = strput(p, end, query_instr_name($2));
		*/
		p = strput(p, end, "' : \"");
		p = get_type_name(p, end, t3);
		p = strput(p, end, "\"");
		yyerror(buf);
	} else if (!compatible_types2(t1,t3)) {
		char buf[256];
		char *end = EndOf(buf);
		char *p;

		p = strput(buf, end, "Arguments to ");
		/* TODO: query_instr_name
		p = strput(p, end, query_instr_name($2));
		*/
		p = strput(p, end, " do not have compatible types : ");
		p = get_two_types(p, end, t1, t3);
		yyerror(buf);
	}
	CREATE_BINARY_OP($$, $2, TYPE_NUMBER, $1, $3);
}
	|	expr0 '+' expr0
{
	debug(grammar, ("expr0 : expr0 + expr0"));
	int result_type;

	int t1 = $1->type, t3 = $3->type;

	if (t1 == t3){
		result_type = t1;
	}
	else if (t1 == TYPE_ANY) {
		result_type = t3;
	} else if (t3 == TYPE_ANY) {
		result_type = t1;
	} else {
		switch(t1) {
			case TYPE_STRING:
				{
					if (t3 == TYPE_REAL || t3 == TYPE_NUMBER){
						result_type = TYPE_STRING;
					} else goto add_error;
					break;
				}
			case TYPE_NUMBER:
				{
					if (t3 == TYPE_REAL || t3 == TYPE_STRING)
						result_type = t3;
					else goto add_error;
					break;
				}
			case TYPE_REAL:
				{
					if (t3 == TYPE_NUMBER) result_type = TYPE_REAL;
					else if (t3 == TYPE_STRING) result_type = TYPE_STRING;
					else goto add_error;
					break;
				}
			default:
				{
					if (t1 & t3 & TYPE_MOD_ARRAY) {
						result_type = TYPE_ANY|TYPE_MOD_ARRAY;
						break;
					}
add_error:
					{
						char buf[256];
						char *end = EndOf(buf);
						char *p;

						p = strput(buf, end, "Invalid argument types to '+' ");
						p = get_two_types(p, end, t1, t3);
						yyerror(buf);
						result_type = TYPE_ANY;
					}
				}
		}
	}

	/* TODO: perhaps we should do (string)+(number) and
	 * (number)+(string) constant folding as well.
	 *
	 * codefor string x = "foo" + 1;
	 *
	 * 0000: push string 13, number 1
	 * 0004: +
	 * 0005: (void)assign_local LV0
	 */
	switch ($1->kind) {
		case NODE_NUMBER:
			/* 0 + X */
			if ($1->v.number == 0 &&
					($3->type == TYPE_NUMBER || $3->type == TYPE_REAL)) {
				$$ = $3;
				break;
			}
			if ($3->kind == NODE_NUMBER) {
				$$ = $1;
				$1->v.number += $3->v.number;
				break;
			}
			if ($3->kind == NODE_REAL) {
				$$ = $3;
				$3->v.real += $1->v.number;
				break;
			}
			/* swapping the nodes may help later constant folding */
			if ($3->type != TYPE_STRING && $3->type != TYPE_ANY)
				CREATE_BINARY_OP($$, F_ADD, result_type, $3, $1);
			else
				CREATE_BINARY_OP($$, F_ADD, result_type, $1, $3);
			break;
		case NODE_REAL:
			if ($3->kind == NODE_NUMBER) {
				$$ = $1;
				$1->v.real += $3->v.number;
				break;
			}
			if ($3->kind == NODE_REAL) {
				$$ = $1;
				$1->v.real += $3->v.real;
				break;
			}
			/* swapping the nodes may help later constant folding */
			if ($3->type != TYPE_STRING && $3->type != TYPE_ANY)
				CREATE_BINARY_OP($$, F_ADD, result_type, $3, $1);
			else
				CREATE_BINARY_OP($$, F_ADD, result_type, $1, $3);
			break;
		case NODE_STRING:
			if ($3->kind == NODE_STRING) {
				/* Combine strings */
				int n1, n2;
				char *new, *s1, *s2;
				int l;

				n1 = $1->v.number;
				n2 = $3->v.number;
				s1 = PROG_STRING(n1);
				s2 = PROG_STRING(n2);
				new = (char *)malloc((l = strlen(s1))+strlen(s2)+1);
				strcpy(new, s1);
				strcat(new + l, s2);
				/* free old strings (ordering may help shrink table) */
				if (n1 > n2) {
					free_prog_string(n1); free_prog_string(n2);
				} else {
					free_prog_string(n2); free_prog_string(n1);
				}
				$$ = $1;
				$$->v.number = store_prog_string(new);
				free(new);
				break;
			}
			/* Yes, this can actually happen for absurd code like:
			 * (int)"foo" + 0
			 * for which I guess we ought to generate (int)"foo"
			 * in order to be consistent.  Then shoot the coder.
			 */
			/* FALLTHROUGH */
		default:
			/* X + 0 */
			if (IS_NODE($3, NODE_NUMBER, 0) &&
					($1->type == TYPE_NUMBER || $1->type == TYPE_REAL)) {
				$$ = $1;
				break;
			}
			CREATE_BINARY_OP($$, F_ADD, result_type, $1, $3);
			break;
	}
}
	|	expr0 '-' expr0
{
	debug(grammar, ("expr0 : expr0 - expr0"));
	int result_type;

	int t1 = $1->type, t3 = $3->type;

	if (t1 == t3){
		switch(t1){
			case TYPE_ANY:
			case TYPE_NUMBER:
			case TYPE_REAL:
				result_type = t1;
				break;
			default:
				if (!(t1 & TYPE_MOD_ARRAY)){
					type_error("Bad argument number 1 to '-'", t1);
					result_type = TYPE_ANY;
				} else result_type = t1;
		}
	} else if (t1 == TYPE_ANY){
		switch(t3){
			case TYPE_REAL:
			case TYPE_NUMBER:
				result_type = t3;
				break;
			default:
				if (!(t3 & TYPE_MOD_ARRAY)){
					type_error("Bad argument number 2 to '-'", t3);
					result_type = TYPE_ANY;
				} else result_type = t3;
		}
	} else if (t3 == TYPE_ANY){
		switch(t1){
			case TYPE_REAL:
			case TYPE_NUMBER:
				result_type = t1;
				break;
			default:
				if (!(t1 & TYPE_MOD_ARRAY)){
					type_error("Bad argument number 1 to '-'", t1);
					result_type = TYPE_ANY;
				} else result_type = t1;
		}
	} else if ((t1 == TYPE_REAL && t3 == TYPE_NUMBER) ||
			(t3 == TYPE_REAL && t1 == TYPE_NUMBER)){
		result_type = TYPE_REAL;
	} else if (t1 & t3 & TYPE_MOD_ARRAY){
		result_type = TYPE_MOD_ARRAY|TYPE_ANY;
	} else {
		char buf[256];
		char *end = EndOf(buf);
		char *p;

		p = strput(buf, end, "Invalid types to '-' ");
		p = get_two_types(p, end, t1, t3);
		yyerror(buf);
		result_type = TYPE_ANY;
	}

	switch ($1->kind) {
		case NODE_NUMBER:
			if ($1->v.number == 0) {
				CREATE_UNARY_OP($$, F_NEGATE, $3->type, $3);
			} else if ($3->kind == NODE_NUMBER) {
				$$ = $1;
				$1->v.number -= $3->v.number;
			} else if ($3->kind == NODE_REAL) {
				$$ = $3;
				$3->v.real = $1->v.number - $3->v.real;
			} else {
				CREATE_BINARY_OP($$, F_SUBTRACT, result_type, $1, $3);
			}
			break;
		case NODE_REAL:
			if ($3->kind == NODE_NUMBER) {
				$$ = $1;
				$1->v.real -= $3->v.number;
			} else if ($3->kind == NODE_REAL) {
				$$ = $1;
				$1->v.real -= $3->v.real;
			} else {
				CREATE_BINARY_OP($$, F_SUBTRACT, result_type, $1, $3);
			}
			break;
		default:
			/* optimize X-0 */
			if (IS_NODE($3, NODE_NUMBER, 0)) {
				$$ = $1;
			}
			CREATE_BINARY_OP($$, F_SUBTRACT, result_type, $1, $3);
	}
}
	|	expr0 '*' expr0
{
	debug(grammar, ("expr0 : expr0 * expr0"));
	int result_type;

	int t1 = $1->type, t3 = $3->type;

	if (t1 == t3){
		switch(t1){
			case TYPE_MAPPING:
			case TYPE_ANY:
			case TYPE_NUMBER:
			case TYPE_REAL:
				result_type = t1;
				break;
			default:
				type_error("Bad argument number 1 to '*'", t1);
				result_type = TYPE_ANY;
		}
	} else if (t1 == TYPE_ANY || t3 == TYPE_ANY){
		int t = (t1 == TYPE_ANY) ? t3 : t1;
		switch(t){
			case TYPE_NUMBER:
			case TYPE_REAL:
			case TYPE_MAPPING:
				result_type = t;
				break;
			default:
				type_error((t1 == TYPE_ANY) ?
						"Bad argument number 2 to '*'" :
						"Bad argument number 1 to '*'",
						t);
				result_type = TYPE_ANY;
		}
	} else if ((t1 == TYPE_NUMBER && t3 == TYPE_REAL) ||
			(t1 == TYPE_REAL && t3 == TYPE_NUMBER)){
		result_type = TYPE_REAL;
	} else {
		char buf[256];
		char *end = EndOf(buf);
		char *p;

		p = strput(buf, end, "Invalid types to '*' ");
		p = get_two_types(p, end, t1, t3);
		yyerror(buf);
		result_type = TYPE_ANY;
	}

	switch ($1->kind) {
		case NODE_NUMBER:
			if ($3->kind == NODE_NUMBER) {
				$$ = $1;
				$$->v.number *= $3->v.number;
				break;
			}
			if ($3->kind == NODE_REAL) {
				$$ = $3;
				$3->v.real *= $1->v.number;
				break;
			}
			CREATE_BINARY_OP($$, F_MULTIPLY, result_type, $3, $1);
			break;
		case NODE_REAL:
			if ($3->kind == NODE_NUMBER) {
				$$ = $1;
				$1->v.real *= $3->v.number;
				break;
			}
			if ($3->kind == NODE_REAL) {
				$$ = $1;
				$1->v.real *= $3->v.real;
				break;
			}
			CREATE_BINARY_OP($$, F_MULTIPLY, result_type, $3, $1);
			break;
		default:
			CREATE_BINARY_OP($$, F_MULTIPLY, result_type, $1, $3);
	}
}
	|	expr0 '%' expr0
{
	debug(grammar, ("expr0 : expr0 %% expr0"));
	$$ = binary_int_op($1, $3, F_MOD, "%");
}
	|	expr0 '/' expr0
{
	debug(grammar, ("expr0 : expr0 / expr0"));
	int result_type;

	int t1 = $1->type, t3 = $3->type;

	if (t1 == t3){
		switch(t1){
			case TYPE_NUMBER:
			case TYPE_REAL:
			case TYPE_ANY:
				result_type = t1;
				break;
			default:
				type_error("Bad argument 1 to '/'", t1);
				result_type = TYPE_ANY;
		}
	} else if (t1 == TYPE_ANY || t3 == TYPE_ANY){
		int t = (t1 == TYPE_ANY) ? t3 : t1;
		if (t == TYPE_REAL || t == TYPE_NUMBER)
			result_type = t;
		else {
			type_error(t1 == TYPE_ANY ?
					"Bad argument 2 to '/'" :
					"Bad argument 1 to '/'", t);
			result_type = TYPE_ANY;
		}
	} else if ((t1 == TYPE_NUMBER && t3 == TYPE_REAL) ||
			(t1 == TYPE_REAL && t3 == TYPE_NUMBER)) {
		result_type = TYPE_REAL;
	} else {
		char buf[256];
		char *end = EndOf(buf);
		char *p;

		p = strput(buf, end, "Invalid types to '/' ");
		p = get_two_types(p, end, t1, t3);
		yyerror(buf);
		result_type = TYPE_ANY;
	}

	/* constant expressions */
	switch ($1->kind) {
		case NODE_NUMBER:
			if ($3->kind == NODE_NUMBER) {
				if ($3->v.number == 0) {
					yyerror("Divide by zero in constant");
					$$ = $1;
					break;
				}
				$$ = $1;
				$1->v.number /= $3->v.number;
				break;
			}
			if ($3->kind == NODE_REAL) {
				if ($3->v.real == 0.0) {
					yyerror("Divide by zero in constant");
					$$ = $1;
					break;
				}
				$$ = $3;
				$3->v.real = ($1->v.number / $3->v.real);
				break;
			}
			CREATE_BINARY_OP($$, F_DIVIDE, result_type, $1, $3);
			break;
		case NODE_REAL:
			if ($3->kind == NODE_NUMBER) {
				if ($3->v.number == 0) {
					yyerror("Divide by zero in constant");
					$$ = $1;
					break;
				}
				$$ = $1;
				$1->v.real /= $3->v.number;
				break;
			}
			if ($3->kind == NODE_REAL) {
				if ($3->v.real == 0.0) {
					yyerror("Divide by zero in constant");
					$$ = $1;
					break;
				}
				$$ = $1;
				$1->v.real /= $3->v.real;
				break;
			}
			CREATE_BINARY_OP($$, F_DIVIDE, result_type, $1, $3);
			break;
		default:
			CREATE_BINARY_OP($$, F_DIVIDE, result_type, $1, $3);
	}
}
	|	cast expr0  %prec L_NOT
{
	debug(grammar, ("expr0 : cast expr0"));
	$$ = $2;
	$$->type = $1;

	if ($2->type != $1 &&
			$2->type != TYPE_ANY &&
			$1 != TYPE_VOID) {
		char buf[256];
		char *end = EndOf(buf);
		char *p;

		p = strput(buf, end, "Cannot cast ");
		p = get_type_name(p, end, $2->type);
		p = strput(p, end, "to ");
		p = get_type_name(p, end, $1);
		yyerror(buf);
	}
}
	|	L_NOT expr0
{
	debug(grammar, ("expr0 : L_NOT expr0"));
	if ($2->kind == NODE_NUMBER) {
		$$ = $2;
		$$->v.number = !($$->v.number);
	} else {
		CREATE_UNARY_OP($$, F_NOT, TYPE_NUMBER, $2);
	}
}
	|	'-' expr0  %prec L_NOT
{
	debug(grammar, ("expr0 : - expr0"));
	int result_type;
	int t = $2->type;
	if (!COMP_TYPE(t, TYPE_NUMBER)){
		type_error("Bad argument to unary '-'", t);
		result_type = TYPE_ANY;
	} else result_type = t;

	switch ($2->kind) {
		case NODE_NUMBER:
			$$ = $2;
			$$->v.number = -$$->v.number;
			break;
		case NODE_REAL:
			$$ = $2;
			$$->v.real = -$$->v.real;
			break;
		default:
			CREATE_UNARY_OP($$, F_NEGATE, result_type, $2);
	}
}
	|	expr4
{
	debug(grammar, ("expr0 : expr4"));
}
	|	number
{
	debug(grammar, ("expr0 : number"));
}
	|	real
{
	debug(grammar, ("expr0 : real"));
}
	;

lvalue:
		expr4
{
	debug(grammar, ("lvalue : expr4"));
#define LV_ILLEGAL 1
#define LV_INDEX 2
	/* Restrictive lvalues, but I think they make more sense :) */
	$$ = $1;
	switch($$->kind) {
		default:
			yyerror("Illegal lvalue");
			break;
		case NODE_OPCODE_1:
		case NODE_BINARY_OP:
			if ($$->v.number == F_LOCAL || $$->v.number == F_GLOBAL)
				$$->v.number++; /* make it an lvalue */
			else if ($$->v.number == F_INDEX) {
				parse_node_t *node = $$;
				int flag = 0;
				do {
					switch(node->kind) {
						case NODE_OPCODE_1:
						case NODE_BINARY_OP:
							if (node->v.number == F_LOCAL || node->v.number == F_GLOBAL) {
								node->v.number++;
								flag |= LV_ILLEGAL;
								break;
							} else if (node->v.number == F_INDEX) {
								node->v.number++;
								flag |= LV_INDEX;
								break;
							} else if (node->v.number == F_ASSIGN) {
								if (!(flag & LV_INDEX)) {
									yyerror("Illegal lvalue, a possible lvalue is (x <assign> y)[a]");
								}
								flag = LV_ILLEGAL;
								break;
							}
						default:
							yyerror("Illegal lvalue");
							flag = LV_ILLEGAL;
							break;
					}
					if ((flag & LV_ILLEGAL) || !(node = node->r.expr)) break;
				} while (1);
				break;
			} else
				yyerror("Illegal lvalue");
			break;
	}
}
	;

expr4:
		function_call
{
	debug(grammar, ("expr4 : function_call"));
}
	|	L_DEFINED_NAME
{
	debug(grammar, ("expr4 : L_DEFINED_NAME"));
	int i;
	if ((i = $1->dn.local_num) != -1) {
		type_of_locals_ptr[i] &= ~LOCAL_MOD_UNUSED;
		CREATE_OPCODE_1($$, F_LOCAL, type_of_locals_ptr[i], i & 0xff);
	} else
		if ((i = $1->dn.global_num) != -1) {
			CREATE_OPCODE_1($$, F_GLOBAL, VAR_TEMP(i)->type, i);
		} else {
			char buf[256];
			char *end = EndOf(buf);
			char *p;

			p = strput(buf, end, "Undefined variable '");
			p = strput(p, end, $1->name);
			p = strput(p, end, "'");
			if (current_number_of_locals < CFG_MAX_LOCAL_VARIABLES) {
				add_local_name($1->name, TYPE_ANY);
			}
			CREATE_ERROR($$);
			yyerror(buf);
		}
}
	|	L_IDENTIFIER
{
	debug(grammar, ("expr4 : L_IDENTIFIER"));
	char buf[256];
	char *end = EndOf(buf);
	char *p;

	p = strput(buf, end, "Undefined variable '");
	p = strput(p, end, $1);
	p = strput(p, end, "'");
	if (current_number_of_locals < CFG_MAX_LOCAL_VARIABLES) {
		add_local_name($1, TYPE_ANY);
	}
	CREATE_ERROR($$);
	yyerror(buf);
	scratch_free($1);
}
	|	expr4 '[' comma_expr ']'
{
	debug(grammar, ("expr4 : expr4 [ comma_expr ]"));
	/* Something stupid like ({ 1, 2, 3 })[1]; we take the
	 * time to optimize this because people who don't understand
	 * the preprocessor often write things like:
	 *
	 * #define MY_ARRAY ({ "foo", "bar", "bazz" })
	 * ...
	 * ... MY_ARRAY[1] ...
	 *
	 * which of course expands to the above.
	 */
	if (IS_NODE($1, NODE_CALL, F_AGGREGATE) && $3->kind == NODE_NUMBER) {
		int i = $3->v.number;
		if (i < 0 || i >= $1->l.number)
			yyerror("Illegal index to array constant.");
		else {
			parse_node_t *node = $1->r.expr;
			while (i--)
				node = node->r.expr;
			$$ = node->v.expr;
			break;
		}
	}
	if ($3->kind == NODE_NUMBER && $3->v.number < 0)
		yywarn("A negative constant in arr[x] no longer means indexing from the end.  Use arr[<x]");
	CREATE_BINARY_OP($$, F_INDEX, 0, $3, $1);
	switch($1->type) {
		case TYPE_MAPPING:
		case TYPE_ANY:
			$$->type = TYPE_ANY;
			break;
		case TYPE_STRING:
			$$->type = TYPE_NUMBER;
			if (!IS_TYPE($3->type,TYPE_NUMBER))
				type_error("Bad type of index", $3->type);
			break;

		default:
			if ($1->type & TYPE_MOD_ARRAY) {
				$$->type = $1->type & ~TYPE_MOD_ARRAY;
				if (!IS_TYPE($3->type,TYPE_NUMBER))
					type_error("Bad type of index", $3->type);
			} else {
				type_error("Value indexed has a bad type ", $1->type);
				$$->type = TYPE_ANY;
			}
	}
}
	|	string
{
	debug(grammar, ("expr4 : string"));
}
	|	'(' comma_expr ')'
{
	debug(grammar, ("expr4 : ( comma_expr )"));
	$$ = $2;
}
	|	L_MAPPING_OPEN expr_list3 ']' ')'
{
	debug(grammar, ("expr4 : L_MAPPING_OPEN expr_list3 ] )"));
	CREATE_CALL($$, F_AGGREGATE_ASSOC, TYPE_MAPPING, $2);
}
	|	L_ARRAY_OPEN expr_list '}' ')'
{
	debug(grammar, ("expr4 : L_ARRAY_OPEN expr_list } )"));
	CREATE_CALL($$, F_AGGREGATE, TYPE_ANY | TYPE_MOD_ARRAY, $2);
}
	;

function_call:
		L_DEFINED_NAME '('
{
	debug(grammar, ("function_call : L_DEFINED_NAME ( ..."));
	$<number>$ = context;
	context |= ARG_LIST;
}
		expr_list ')'
{
	debug(grammar, ("function_call : ... expr_list )"));
	int f;

	context = $<number>3;
	$$ = $4;

	if ((f = $1->dn.function_num) != -1) {
		$$->kind = NODE_CALL_1;
		$$->v.number = F_CALL_FUNCTION_BY_ADDRESS;
		$$->l.number = f;
		$$->type = validate_function_call(f, $4->r.expr);
	} else if ((f=$1->dn.simul_num) != -1) {
		/** TODO: simul efun
		$$->kind = NODE_CALL_1;
		$$->v.number = F_SIMUL_EFUN;
		$$->l.number = f;
		$$->type = SIMUL(f)->type;
		*/
	} else if ((f=$1->dn.efun_num) != -1) {
		$$ = validate_efun_call(f, $4);
	} else {
		/* This here is a really nasty case that only occurs with
		 * exact_types off.  The user has done something gross like:
		 *
		 * func() { int f; f(); } // if f was prototyped we wouldn't
		 * f() { }                // need this case
		 *
		 * Don't complain, just grok it.
		 */
		$$->kind = NODE_CALL_1;
		$$->v.number = F_CALL_FUNCTION_BY_ADDRESS;
		$$->l.number = -1;
		$$->type = TYPE_ANY;

		char buf[256];
		char *end = EndOf(buf);
		char *p;
		char *n = $1->name;
		p = strput(buf, end, "Undefined function ");
		p = strput(p, end, n);
		yyerror(buf);
	}
}
	|	L_IDENTIFIER '('
{
	debug(grammar, ("function_call : L_IDENTIFIER ( ..."));
	$<number>$ = context;
	context |= ARG_LIST;
}
		expr_list ')'
{
	debug(grammar, ("function_call : ... expr_list )"));
	context = $<number>3;
	$$ = $4;

	$$->kind = NODE_CALL_1;
	$$->v.number = F_CALL_FUNCTION_BY_ADDRESS;
	$$->l.number = -1;
	$$->type = TYPE_ANY;

	char buf[256];
	char *end = EndOf(buf);
	char *p;
	char *n = $1;
	p = strput(buf, end, "Undefined function ");
	p = strput(p, end, n);
	yyerror(buf);

	scratch_free($1);
}
	|	expr4 L_ARROW identifier '('
{
	debug(grammar, ("function_call : expr4 L_ARROW identifier ( ..."));
	$<number>$ = context;
	context |= ARG_LIST;
}
		expr_list ')'
{
	debug(grammar, ("function_call : ... expr_list )"));
	ident_hash_elem_t *ihe;
	int f;
	parse_node_t *pn1, *pn2;

	$6->v.number += 2;

	pn1 = new_node_no_line();
	pn1->type = 0;
	pn1->v.expr = $1;
	pn1->kind = $6->v.number;

	pn2 = new_node_no_line();
	pn2->type = 0;
	CREATE_STRING(pn2->v.expr, $3);
	scratch_free($3);

	/* insert the two nodes */
	pn2->r.expr = $6->r.expr;
	pn1->r.expr = pn2;
	$6->r.expr = pn1;

	if (!$6->l.expr) $6->l.expr = pn2;

	context = $<number>5;
	ihe = lookup_ident("call_other");

	if ((f = ihe->dn.simul_num) != -1) {
		/* TODO: simul efun
		$$ = $6;
		$$->kind = NODE_CALL_1;
		$$->v.number = F_SIMUL_EFUN;
		$$->l.number = f;
		$$->type = (SIMUL(f)->type) & ~DECL_MODS;
		*/
	} else {
		$$ = validate_efun_call(arrow_efun, $6);
		$$->type = TYPE_ANY;
	}
}
	;

expr_list:
		/* empty */
{
	debug(grammar, ("expr_list : "));
	CREATE_EXPR_LIST($$, 0);
}
	|	expr_list2
{
	debug(grammar, ("expr_list : expr_list2"));
	CREATE_EXPR_LIST($$, $1);
}
	|	expr_list2 ','
{
	debug(grammar, ("expr_list : expr_list2 ,"));
	CREATE_EXPR_LIST($$, $1);
}
	;

expr_list2:
		expr_list_node
{
	debug(grammar, ("expr_list2 : expr_list_node"));
	$1->kind = 1;

	$$ = $1;
}
	|	expr_list2 ',' expr_list_node
{
	debug(grammar, ("expr_list2 : expr_list2 , expr_list_node"));
	$3->kind = 0;

	$$ = $1;
	$$->kind++;
	$$->l.expr->r.expr = $3;
	$$->l.expr = $3;
}
	;

expr_list_node:
		expr0
{
	debug(grammar, ("expr_list_node : expr0"));
	CREATE_EXPR_NODE($$, $1, 0);
}
	;

comma_expr:
		expr0
{
	debug(grammar, ("comma_expr : expr0"));
	$$ = $1;
}
	|	comma_expr ',' expr0
{
	debug(grammar, ("comma_expr : comma_expr , expr0"));
	CREATE_TWO_VALUES($$, $3->type, pop_value($1), $3);
}
	;

string:
		L_STRING
{
	debug(grammar, ("string : L_STRING"));
	CREATE_STRING($$, $1);
	scratch_free($1);
}
	;

expr_list3:
		/* empty */
{
	debug(grammar, ("expr_list3 : "));
	CREATE_EXPR_LIST($$, 0);
}
	|	expr_list4
{
	debug(grammar, ("expr_list3 : expr_list4"));
	CREATE_EXPR_LIST($$, $1);
}
	|	expr_list4 ','
{
	debug(grammar, ("expr_list3 : expr_list4 ,"));
	CREATE_EXPR_LIST($$, $1);
}
	;

expr_list4:
		assoc_pair
{
	debug(grammar, ("expr_list4 : assoc_pair"));
	$$ = new_node_no_line();
	$$->kind = 2;
	$$->v.expr = $1;
	$$->r.expr = 0;
	$$->type = 0;
	/* we keep track of the end of the chain in the left nodes */
	$$->l.expr = $$;
}
	|	expr_list4 ',' assoc_pair
{
	debug(grammar, ("expr_list4 : expr_list4 , assoc_pair"));
	parse_node_t *expr;

	expr = new_node_no_line();
	expr->kind = 0;
	expr->v.expr = $3;
	expr->r.expr = 0;
	expr->type = 0;

	$1->l.expr->r.expr = expr;
	$1->l.expr = expr;
	$1->kind += 2;
	$$ = $1;
}
	;

assoc_pair:
		expr0 ':' expr0
{
	debug(grammar, ("assoc_pair : expr0 : expr0"));
	CREATE_TWO_VALUES($$, 0, $1, $3);
}
	;

cast:
		'(' L_BASIC_TYPE optional_star ')'
{
	debug(grammar, ("cast : ( L_BASIC_TYPE optional_star )"));
	$$ = $2 | $3;
	if ($2 == TYPE_VOID && $3) {
		yyerror("Illegal to declare type void *.");
	}
}
	;

number:
		L_NUMBER
{
	debug(grammar, ("number : L_NUMBER"));
	CREATE_NUMBER($$, $1);
}
	;

real:
		L_REAL
{
	debug(grammar, ("real : L_REAL"));
	CREATE_REAL($$, $1);
}
	;

statements:
		/* empty */
{
	debug(grammar, ("statements : "));
	$$ = 0;
}
	|	statement statements
{
	debug(grammar, ("statements : statement statements"));
	if ($1 && $2) {
		CREATE_STATEMENTS($$, $1, $2);
	} else $$ = ($1 ? $1 : $2);
}
	|	error ';'
{
	debug(grammar, ("statements : error ;"));
	$$ = 0;
}
	;

statement:
		comma_expr ';'
{
	debug(grammar, ("statement : comma_expr ;"));
	$$ = pop_value($1);
#ifdef DEBUG
	{
		parse_node_t *replacement;
		CREATE_STATEMENTS(replacement, $$, 0);
		CREATE_OPCODE(replacement->r.expr, F_BREAK_POINT, 0);
		$$ = replacement;
	}
#endif
}
	|	cond
{
	debug(grammar, ("statement : cond"));
}
	|	while
{
	debug(grammar, ("statement : while"));
}
	|	do
{
	debug(grammar, ("statement : do"));
}
	|	return
{
	debug(grammar, ("statement : return"));
}
	|	decl_block
{
	debug(grammar, ("statement : decl_block"));
	$$ = $1.node;
	pop_n_locals($1.num);
}
	|	/* empty */ ';'
{
	debug(grammar, ("statement : ;"));
	$$ = 0;
}
	|	L_BREAK ';'
{
	debug(grammar, ("statement : L_BREAK ;"));
	if (context & LOOP_CONTEXT) {
		CREATE_CONTROL_JUMP($$, CJ_BREAK);
		if (context & LOOP_FOREACH) {
			parse_node_t *replace;
			CREATE_STATEMENTS(replace, 0, $$);
			CREATE_OPCODE(replace->l.expr, F_EXIT_FOREACH, 0);
			$$ = replace;
		}
	} else {
		yyerror("break statement outside loop");
		$$ = 0;
	}
}
	|	L_CONTINUE ';'
{
	debug(grammar, ("statement : L_CONTINUE ;"));
	if (!(context & LOOP_CONTEXT))
		yyerror("continue statement outside loop");
	CREATE_CONTROL_JUMP($$, CJ_CONTINUE);
}
	;

cond:
		L_IF '(' comma_expr ')' statement optional_else_part
{
	debug(grammar, ("cond : L_IF ( comma_expr ) statement optional_else_part"));
	/* x != 0 -> x */
	if (IS_NODE($3, NODE_BINARY_OP, F_NE)) {
		if (IS_NODE($3->r.expr, NODE_NUMBER, 0))
			$3 = $3->l.expr;
		else if (IS_NODE($3->l.expr, NODE_NUMBER, 0))
			$3 = $3->r.expr;
	}

	/* TODO: should optimize if (0), if (1) here.
	 * Also generalize this.
	 */

	if ($5 == 0) {
		if ($6 == 0) {
			/* if (x) ; -> x; */
			$$ = pop_value($3);
			break;
		} else {
			/* if (x) {} else y; -> if (!x) y; */
			parse_node_t *repl;

			CREATE_UNARY_OP(repl, F_NOT, TYPE_NUMBER, $3);
			$3 = repl;
			$5 = $6;
			$6 = 0;
		}
	}
	CREATE_IF($$, $3, $5, $6);
}
	;

optional_else_part:
		/* empty */    %prec LOWER_THAN_ELSE
{
	debug(grammar, ("optional_else_part : "));
	$$ = 0;
}
	|	L_ELSE statement
{
	debug(grammar, ("optional_else_part : L_ELSE statement"));
	$$ = $2;
}
	;

while:
		L_WHILE '(' comma_expr ')'
{
	debug(grammar, ("while : L_WHILE ( comma_expr ) ..."));
	$<number>1 = context;
	context = LOOP_CONTEXT;
}
		statement
{
	debug(grammar, ("while : ... statement"));
	CREATE_LOOP($$, 1, $6, 0, optimize_loop_test($3));
	context = $<number>1;
}
	;

do:
		L_DO
{
	debug(grammar, ("do : L_DO ..."));
	$<number>1 = context;
	context = LOOP_CONTEXT;
}
		statement L_WHILE '(' comma_expr ')' ';'
{
	debug(grammar, ("do : ... statement L_WHILE ( comma_expr ) ;"));
	CREATE_LOOP($$, 0, $3, 0, optimize_loop_test($6));
	context = $<number>1;
}
	;

return:
		L_RETURN ';'
{
	debug(grammar, ("return : L_RETURN ;"));
	if (!IS_TYPE(exact_types, TYPE_VOID))
		yywarn("Non-void functions must return a value.");
	CREATE_RETURN($$, 0);
}
	|	L_RETURN comma_expr ';'
{
	debug(grammar, ("return : L_RETURN comma_expr ;"));
	if (!compatible_types($2->type, exact_types)) {
		char buf[256];
		char *end = EndOf(buf);
		char *p;

		p = strput(buf, end, "Type of returned value doesn't match function return type ");
		p = get_two_types(p, end, $2->type, exact_types);
		yyerror(buf);
	}
	if (IS_NODE($2, NODE_NUMBER, 0)) {
		CREATE_RETURN($$, 0);
	} else {
		CREATE_RETURN($$, $2);
	}
}
	;

decl_block:
		block
{
	debug(grammar, ("decl_block : block"));
}
	|	for
{
	debug(grammar, ("decl_block : for"));
}
	|	foreach
{
	debug(grammar, ("decl_block : foreach"));
}
	;

for:
		L_FOR '(' first_for_expr ';' for_expr ';' for_expr ')'
{
	debug(grammar, ("for : L_FOR ( first_for_expr ; for_expr ; for_expr ) ..."));
	$3.node = pop_value($3.node);
	$<number>1 = context;
	context = LOOP_CONTEXT;
}
		statement
{
	debug(grammar, ("for : ... statement"));
	$$.num = $3.num; /* number of declarations (0/1) */

	$7 = pop_value($7);

	CREATE_STATEMENTS($$.node, $3.node, 0);
	CREATE_LOOP($$.node->r.expr, 1, $10, $7, optimize_loop_test($5));

	context = $<number>1;
}
	;

first_for_expr:
		for_expr
{
	debug(grammar, ("first_for_expr : for_expr"));
	$$.node = $1;
	$$.num = 0;
}
	|	single_new_local_def_with_init
{
	debug(grammar, ("first_for_expr : single_new_local_def_with_init"));
	$$.node = $1;
	$$.num = 1;
}
	;

for_expr:
		/* empty */
{
	debug(grammar, ("for_expr : "));
	$$ = 0;
}
	|	comma_expr
{
	debug(grammar, ("for_expr : comma_expr"));
}
	;

single_new_local_def_with_init:
		single_new_local_def L_ASSIGN expr0
{
	debug(grammar, ("single_new_local_def_with_init : single_new_local_def L_ASSIGN expr0"));
	int type = type_of_locals_ptr[$1];

	type &= ~LOCAL_MOD_UNUSED;

	if ($2 != F_ASSIGN)
		yyerror("Only '=' is allowed in initializers.");
	if (!compatible_types($3->type, type)) {
		char buff[256];
		char *end = EndOf(buff);
		char *p;

		p = strput(buff, end, "Type mismatch ");
		p = get_two_types(p, end, type, $3->type);
		p = strput(p, end, " when initializing.");
		yyerror(buff);
	}

	$3 = do_promotions($3, type);

	/* this is an expression */
	CREATE_BINARY_OP($$, F_ASSIGN, 0, $3, 0);
	CREATE_OPCODE_1($$->r.expr, F_LOCAL_LVALUE, 0, $1);
}
	;

single_new_local_def:
		L_BASIC_TYPE optional_star new_local_name
{
	debug(grammar, ("single_new_local_def : L_BASIC_TYPE optional_star new_local_name"));
	if ($1 == TYPE_VOID) {
		yyerror("Illegal to declare local variable of type void.");
	}

	$$ = add_local_name($3, $1 | $2);
	scratch_free($3);
}
	;

foreach:
		L_FOREACH '(' foreach_vars L_IN expr0 ')'
{
	debug(grammar, ("foreach : L_FOREACH ( foreach_vars L_IN expr0 ) ..."));
	$3.node->v.expr = $5;
	$<number>1 = context;
	context = LOOP_CONTEXT | LOOP_FOREACH;
}
		statement
{
	debug(grammar, ("foreach : ... statement"));
	$$.num = $3.num;

	CREATE_STATEMENTS($$.node, $3.node, 0);
	CREATE_LOOP($$.node->r.expr, 2, $8, 0, 0);
	CREATE_OPCODE($$.node->r.expr->r.expr, F_NEXT_FOREACH, 0);

	context = $<number>1;
}
	;

foreach_vars:
		foreach_var
{
	debug(grammar, ("foreach_vars : foreach_var"));
	CREATE_FOREACH($$.node, $1.node, 0);
	$$.num = $1.num;
}
	|	foreach_var ',' foreach_var
{
	debug(grammar, ("foreach_vars : foreach_var , foreach_var"));
	CREATE_FOREACH($$.node, $1.node, $3.node);
	$$.num = $1.num + $3.num;
}
	;

foreach_var:
		L_DEFINED_NAME
{
	debug(grammar, ("foreach_var : L_DEFINED_NAME"));
	if ($1->dn.local_num != -1) {
		CREATE_OPCODE_1($$.node, F_LOCAL_LVALUE, 0, $1->dn.local_num);
		type_of_locals_ptr[$1->dn.local_num] &= ~LOCAL_MOD_UNUSED;
	} else
		if ($1->dn.global_num != -1) {
			CREATE_OPCODE_1($$.node, F_GLOBAL_LVALUE, 0, $1->dn.global_num);
		} else {
			char buf[256];
			char *end = EndOf(buf);
			char *p;

			p = strput(buf, end, "'");
			p = strput(p, end, $1->name);
			p = strput(p, end, "' is not a local or a global variable.");
			yyerror(buf);
			CREATE_OPCODE_1($$.node, F_GLOBAL_LVALUE, 0, 0);
		}
	$$.num = 0;
}
	|	single_new_local_def
{
	debug(grammar, ("foreach_var : single_new_local_def"));
	CREATE_OPCODE_1($$.node, F_LOCAL_LVALUE, 0, $1);
	type_of_locals_ptr[$1] &= ~LOCAL_MOD_UNUSED;
	$$.num = 1;
}
	|	L_IDENTIFIER
{
	debug(grammar, ("foreach_var : L_IDENTIFIER"));
	char buf[256];
	char *end = EndOf(buf);
	char *p;

	p = strput(buf, end, "'");
	p = strput(p, end, $1);
	p = strput(p, end, "' is not a local or a global variable.");
	yyerror(buf);
	CREATE_OPCODE_1($$.node, F_GLOBAL_LVALUE, 0, 0);
	scratch_free($1);
	$$.num = 0;
}
	;

possible_semi_colon:
		/* empty */
{
	debug(grammar, ("possible_semi_colon : "));
}
	|	';'
{
	debug(grammar, ("possible_semi_colon : ;"));
	yywarn("Extra ';'. Ignored.");
}
	;

%%
